home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / examples / bsp2 / flowm.f9 < prev    next >
Text File  |  1993-06-15  |  2KB  |  65 lines
  1.       program flow
  2.       implicit none
  3.  
  4. c     dimension of image: x_dim x y_dim
  5.  
  6.       integer x_dim, y_dim, points
  7.       parameter (x_dim = 128, y_dim = 128)
  8.       integer x_h, y_h
  9.       parameter (x_h = x_dim / 2, y_h = y_dim / 2)
  10.       parameter (points = 4096)
  11.       integer i, j
  12.  
  13.       real x_coord(points), y_coord(points), dx (points), dy (points)
  14.       integer image_buffer (x_dim, y_dim )
  15. cmf$  layout image_buffer (:host)
  16.       integer image (x_dim, y_dim)
  17.       integer x (points), y (points)
  18.       logical mask (points)
  19.       integer color (points)
  20.       integer dummy
  21.  
  22.       i = x_dim
  23.       j = y_dim
  24.       call x_display_init (x_dim,y_dim)
  25.  
  26.       x_coord = 0
  27.       y_coord = 0
  28.       do i = 1, points !parallel
  29.          x_coord(i)=sin(i*2*3.1415926*8/real(points))
  30.      $              *(real(i)/real(points))
  31.       end do
  32.       do i = 1,points
  33.          y_coord(i)=cos(i*2*3.1415926*8/real(points))
  34.      $              *(real(i)/real(points))
  35.       end do
  36.       x_coord = 0.5*x_coord
  37.       y_coord = 0.5*y_coord
  38.       do i = 1, 250
  39.         dx = x_coord + (i/25.0) * y_coord * x_coord
  40.         dy = - y_coord - (i/50.0) * x_coord * (y_coord-x_coord)
  41.         x_coord = x_coord + 0.01 * dx
  42.         y_coord = y_coord + 0.01 * dy
  43. c       display all points
  44.         image = 50
  45.         do j = 1, points   !parallel
  46.            x(j) = x_h + x_coord(j) * x_h
  47.            y(j) = y_h + y_coord(j) * y_h
  48.            mask (j) = ((x(j) .gt. 0) .and. (x(j) .le. x_dim) .and.
  49.      $                 (y(j) .gt. 0) .and. (y(j) .le. y_dim))
  50.            color (j) = 255
  51.         end do
  52. c
  53. c       global send with a mask
  54. c
  55. c       scatter for a two dimensional structure with mask
  56. c
  57. c       send only if x, y coordinates are in range 
  58. c
  59.         call global_send (image, x, y, color, mask)
  60.         image_buffer = image
  61.         call x_show_bild (image_buffer)
  62.       end do
  63.       read *, dummy
  64.       end 
  65.